home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 5 / Apprentice-Release5.iso / Source Code / C / Applications / Moscow ML 1.31 / source code / mosml / src / mosmllib / Array.mlp next >
Encoding:
Text File  |  1996-07-03  |  5.5 KB  |  195 lines  |  [TEXT/R*ch]
  1. (* Array -- new basis 1994-11-21, 1995-05-21 *)
  2.  
  3. (* In fact, type 'a array = 'a array_ ref, but for the static equality
  4.  * type to be right, we need to declare it a prim_EQtype:              *)
  5. prim_EQtype 'a array;
  6.  
  7. local 
  8.     prim_type 'a array_;
  9.  
  10.     type 'a vector = 'a Vector.vector;
  11.  
  12.     prim_val length_  : 'a array_ -> int               = 1 "vect_length";
  13.     prim_val lengthv_ : 'a vector -> int               = 1 "vect_length";
  14.  
  15.     prim_val array_  : int -> 'x -> 'a array_          = 2 "make_ref_vect";
  16.     (* array_ has a non-imperative type for the sake of array0, and a
  17.        very flexible type 'x to allow initialization.  Thus type
  18.        correctness inside this unit body depends on type annotations.
  19.     *)
  20.  
  21.     prim_val vector_ : int -> 'x -> 'a vector          = 2 "make_vect";
  22.     prim_val sub_    : 'a array_ -> int -> 'a          = 2 "get_vect_item";
  23.     prim_val subv_   : 'a vector -> int -> 'a          = 2 "get_vect_item";
  24.     prim_val update_ : 'a array_ -> int -> 'a -> unit  = 3 "set_vect_item";
  25.     prim_val updatev : 'a vector -> int -> 'a -> unit  = 3 "set_vect_item";
  26.  
  27.     prim_val magic   : 'a -> 'b                        = 1 "identity";
  28.  
  29.     fun from_array (a : 'a  array)  = !(magic a)    : 'a array_
  30.     fun make_array (a : '_a array_) = magic (ref a) : 'a array
  31. in 
  32.  
  33. #include "../config/m.h"
  34. #ifdef SIXTYFOUR
  35. val maxLen = 18014398509481983; (* = 2^54-1, for 64-bit architectures *)
  36. #else
  37. val maxLen = 4194303;       (* = 2^22-1, for 32-bit architectures *)
  38. #endif
  39.  
  40. val array0 = make_array (array_ 0 ()) : 'a array;
  41.  
  42. fun array(n, v : '_a) =
  43.   if n < 0 orelse n > maxLen then raise Size 
  44.   else make_array (array_ n v) : '_a array;
  45.  
  46. fun tabulate(n, f : int -> '_a) =
  47.   if n < 0 orelse n > maxLen then raise Size else
  48.   let val a = array_ n () : '_a array_
  49.       fun init i = if i >= n then () else (update_ a i (f i); init (i+1))
  50.   in (init 0; make_array a : '_a array) end;
  51.  
  52. fun fromList (vs : '_a list) =
  53.     let val n = List.length vs
  54.     val a = if n > maxLen then raise Size
  55.         else (array_ n () : '_a array_)
  56.     fun init [] i = ()
  57.       | init (v::vs) i = (update_ a i v; init vs (i+1))
  58.     in (init vs 0; make_array a : '_a array) end;
  59.  
  60. fun length a = length_ (from_array a);
  61.  
  62. fun sub(a, i) =
  63.     let val a = from_array a 
  64.     in
  65.     if i < 0 orelse i >= length_ a then raise Subscript 
  66.     else sub_ a i 
  67.     end
  68.  
  69. fun update(a, i, v) =
  70.     let val a = from_array a 
  71.     in
  72.     if i < 0 orelse i >= length_ a then raise Subscript 
  73.     else update_ a i v
  74.     end
  75.  
  76. fun extract (a : 'a array, i, slicelen) =
  77.     let val a = from_array a : 'a array_ 
  78.     val n = case slicelen of NONE => length_ a - i | SOME n => n
  79.     val newvec = if i<0 orelse n<0 orelse i+n > length_ a 
  80.              then raise Subscript
  81.              else vector_ n () : 'a vector
  82.     fun copy j = 
  83.         if j<n then
  84.         (updatev newvec j (sub_ a (i+j)); copy (j+1))
  85.         else
  86.         ()
  87.     in copy 0; newvec end;
  88.  
  89. fun copy {src=a1: 'a array, si=i1, dst=a2: 'a array, di=i2, len=n} =
  90.     let val a1 = from_array a1
  91.     and a2 = from_array a2
  92.     in
  93.     if n<0 orelse i1<0 orelse i1+n > length_ a1
  94.         orelse i2<0 orelse i2+n > length_ a2
  95.     then 
  96.         raise Subscript
  97.     else if i1 < i2 then        (* copy from high to low *)
  98.              let fun hi2lo j = 
  99.              if j >= 0 then
  100.              (update_ a2 (i2+j) (sub_ a1 (i1+j)); hi2lo (j-1))
  101.              else ()
  102.          in hi2lo (n-1) end
  103.          else                       (* i1 >= i2, copy from low to high *)
  104.          let fun lo2hi j = 
  105.              if j < n then
  106.              (update_ a2 (i2+j) (sub_ a1 (i1+j)); lo2hi (j+1))
  107.              else ()
  108.          in lo2hi 0 end
  109.     end
  110.  
  111. fun copyv {src=a1: 'a vector, si=i1, dst=a2: 'a array, di=i2, len=n} =
  112.     let val a2 = from_array a2
  113.     in
  114.     if n<0 orelse i1<0 orelse i1+n > lengthv_ a1
  115.            orelse i2<0 orelse i2+n > length_ a2
  116.         then 
  117.         raise Subscript
  118.     else 
  119.         let fun lo2hi j = if j < n then
  120.         (update_ a2 (i2+j) (subv_ a1 (i1+j)); lo2hi (j+1))
  121.                   else ()
  122.         in lo2hi 0 end
  123.     end;
  124.  
  125. fun foldl f e a = 
  126.     let val a = from_array a
  127.     val stop = length_ a
  128.     fun lr j res = if j < stop then lr (j+1) (f(sub_ a j, res))
  129.                else res
  130.     in lr 0 e end
  131.  
  132. fun foldr f e a =
  133.     let val a = from_array a
  134.     fun rl j res = if j >= 0 then rl (j-1) (f(sub_ a j, res))
  135.                else res
  136.     in rl (length_ a - 1) e end
  137.  
  138. fun modify f a = 
  139.     let val a = from_array a
  140.     val stop = length_ a
  141.     fun lr j = if j < stop then (update_ a j (f(sub_ a j)); lr (j+1))
  142.            else ()
  143.     in lr 0 end
  144.  
  145. fun app f a = 
  146.     let val a = from_array a
  147.     val stop = length_ a
  148.     fun lr j = if j < stop then (f(sub_ a j); lr (j+1))
  149.            else ()
  150.     in lr 0 end
  151.  
  152. fun sliceend (a, i, NONE) = 
  153.         if i<0 orelse i>length a then raise Subscript
  154.     else length a
  155.   | sliceend (a, i, SOME n) = 
  156.     if i<0 orelse n<0 orelse i+n>length a then raise Subscript
  157.     else i+n;
  158.  
  159. fun foldli f e (slice as (a, i, _)) = 
  160.     let val a = from_array a
  161.     fun loop stop =
  162.         let fun lr j res = 
  163.         if j < stop then lr (j+1) (f(j, sub_ a j, res))
  164.         else res
  165.         in lr i e end
  166.     in loop (sliceend slice) end;
  167.  
  168. fun foldri f e (slice as (a, i, _)) = 
  169.     let val a = from_array a
  170.     fun loop start =
  171.         let fun rl j res = 
  172.             if j >= i then rl (j-1) (f(j, sub_ a j, res))
  173.             else res
  174.         in rl start e end;
  175.     in loop (sliceend slice - 1) end
  176.  
  177. fun modifyi f (slice as (a, i, _)) = 
  178.     let val a = from_array a
  179.     fun loop stop =
  180.         let fun lr j = 
  181.         if j < stop then (update_ a j (f(j, sub_ a j)); lr (j+1))
  182.         else ()
  183.         in lr i end
  184.     in loop (sliceend slice) end;
  185.  
  186. fun appi f (slice as (a, i, _)) = 
  187.     let val a = from_array a
  188.     fun loop stop = 
  189.         let    fun lr j = 
  190.             if j < stop then (f(j, sub_ a j); lr (j+1)) 
  191.             else ()
  192.         in lr i end
  193.     in loop (sliceend slice) end;
  194. end
  195.